home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Turing / tm.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-25  |  3.7 KB  |  123 lines  |  [TEXT/3PRM]
  1. implementation module tm
  2.  
  3. import    StdClass, StdBool, StdString, StdChar, StdInt, StdArray, StdList
  4.  
  5. ::    TmState
  6.     =    {    turing        :: !Turing
  7.         ,    transition    :: !TrNr
  8.         ,    command        :: !Comm
  9.         }
  10. ::    Turing
  11.     =    {    transitions    :: ![Transition]
  12.         ,    tape        :: !Tape
  13.         ,    state        :: !State
  14.         }
  15. ::    Transition
  16.     =    {    start        :: !State
  17.         ,    sigma        :: !Head
  18.         ,    end            :: !State
  19.         ,    move        :: !Char
  20.         }
  21. ::    Tape
  22.     =    {    content        :: !String
  23.         ,    head        :: !Int
  24.         }
  25. ::    State    :== String
  26. ::    Head    :== Char
  27. ::    TrNr    :== Int
  28. ::    Comm    =    Erase | None | MoveR1 | MoveR | MoveL | Halt | ErrorL | ErrorT
  29.             |    Write Char
  30.  
  31.  
  32. //    Execute a Turing machine.
  33. Step :: !TmState -> TmState
  34. Step {turing}
  35. =    {turing={turing & tape=newtape,state=newstate},transition=transition_nr,command=newcommand}
  36. where
  37.     tape                            = turing.tape
  38.     head                            = tape.content.[tape.head]
  39.     (transition_nr,transition)        = SelectTransition 0 head turing.state turing.transitions
  40.     (newtape,newstate,newcommand)    = ApplyTransition transition tape
  41.     
  42.     SelectTransition :: !Int !Head !State ![Transition] -> (!TrNr,!Transition)
  43.     SelectTransition n head state [transition=:{start,sigma}:transitions]
  44.     |    head==sigma && state==start    = (n,transition)
  45.     |    otherwise                    = SelectTransition (n+1) head state transitions
  46.     SelectTransition _ _ _ _
  47.         = (0,{start="",sigma='_',end="error",move='_'})
  48.     
  49.     ApplyTransition :: !Transition !Tape -> (!Tape,!State,!Comm)
  50.     ApplyTransition {end,move} tape
  51.     |    end=="error"    = (tape,end,ErrorT)
  52.     |    move=='L'        = left tape end
  53.                         with
  54.                             left :: !Tape !State -> (!Tape,!State,!Comm)
  55.                             left tape end
  56.                             |    tape.head==0            = (tape,"error",ErrorL)
  57.                             |    otherwise                = ({tape & head=tape.head-1},end,MoveL)
  58.     |    move=='R'        = right tape end
  59.                         with
  60.                             right :: !Tape !State -> (!Tape,!State,!Comm)
  61.                             right tape=:{content,head} end
  62.                             |    pos>=size content        = ({content=content+++"#",head=pos},end,MoveR1)
  63.                             |    otherwise                = ({tape & head=pos},end,MoveR)
  64.                             where
  65.                                 pos                        = head+1
  66.     |    otherwise        = write tape move end
  67.                         with
  68.                             write :: !Tape !Char State -> (!Tape,!State,!Comm)
  69.                             write tape=:{content,head} move end
  70.                             |    move=='#'                = ({tape & content=content:=(head,'#')},end,Erase)
  71.                             |    move==content.[head]    = (tape,end,None)
  72.                             |    otherwise                = ({tape & content=content:=(head,move)},end,Write move)
  73.  
  74.  
  75. //    Functions to inspect and change the tape.
  76. CellContents :: !Int !Tape -> Char
  77. CellContents pos {content,head}
  78. |    pos>=NrOfCells content    = '#'
  79. |    otherwise                = content.[head]
  80.  
  81. ChangeCellContents :: !Int !Char !Tape -> Tape
  82. ChangeCellContents pos cell tape=:{content,head}
  83. |    pos>=NrOfCells content    = {tape & content=content+++toString cell}
  84. |    otherwise                = {tape & content=content:=(head,cell)}
  85.  
  86. MoveHead :: !Int !Tape -> Tape
  87. MoveHead pos tape=:{content,head}
  88. |    pos>=length                = {tape & content=ExtendContents content head length}
  89. |    otherwise                = tape
  90. where
  91.     length                    = NrOfCells content
  92.     
  93.     ExtendContents :: !String !Int !Int -> String
  94.     ExtendContents content max pos
  95.     |    pos>max                = content
  96.     |    otherwise            = ExtendContents (content+++"#") max (pos+1)
  97.  
  98. NrOfCells :: !String -> Int
  99. NrOfCells cont = size cont
  100.  
  101.  
  102. //    Functions to inspect and change the transitions.
  103. GetTransition :: Int ![Transition] -> Transition
  104. GetTransition n trs
  105. |    isEmpty trs        = {start="",sigma=' ',end="",move=' '}
  106. |    n==0            = hd trs
  107. |    otherwise        = GetTransition (n-1) (tl trs)
  108.  
  109. ChangeTransition :: Int Transition ![Transition] -> [Transition]
  110. ChangeTransition n t trs
  111. |    isEmpty trs        = [t]
  112. |    n==0            = [t:tl trs]
  113. |    otherwise        = [hd trs:ChangeTransition (n-1) t (tl trs)]
  114.  
  115. RemoveTransition :: Int ![Transition] -> [Transition]
  116. RemoveTransition n trs
  117. |    isEmpty trs        = trs
  118. |    n==0            = tl trs
  119. |    otherwise        = [hd trs:RemoveTransition (n-1) (tl trs)]
  120.  
  121. NrOfTransitions :: ![Transition] -> Int
  122. NrOfTransitions    trs = length trs
  123.